indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.3 v dplyr 1.0.7
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 2.0.0 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 408)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 13.01904 13.01543 13.01185 13.00831 13.00481 13.00134 12.99791 12.99451
## [9] 12.99116 12.98784 12.98456 12.98132 12.97812 12.97496 12.97184 12.96877
## [17] 12.96573 12.96273 12.95978 12.95687 12.95400 12.95117 12.94839 12.94566
## [25] 12.94296 12.94031 12.93771 12.93515 12.93264 12.93017 12.92775 12.92538
## [33] 12.92306 12.92078 12.91855 12.91637 12.91424 12.91218 12.91016 12.90820
## [41] 12.90630 12.90446 12.90266 12.90092 12.89924 12.89760 12.89602 12.89449
## [49] 12.89301 12.89158 12.89019 12.88886 12.88758 12.88634 12.88515 12.88401
## [57] 12.88291 12.88185 12.88085 12.87988 12.87896 12.87808 12.87725 12.87645
## [65] 12.87570 12.87499 12.87432 12.87368 12.87309 12.87253 12.87201 12.87153
## [73] 12.87108 12.87067 12.87030 12.86996 12.86965 12.86938 12.86918 12.86908
## [81] 12.86909 12.86919 12.86939 12.86968 12.87007 12.87053 12.87108 12.87170
## [89] 12.87240 12.87316 12.87400 12.87489 12.87585 12.87686 12.87793 12.87904
## [97] 12.88020 12.88140 12.88263 12.88390 12.88521 12.88653 12.88789 12.88926
## [105] 12.89064 12.89205 12.89345 12.89487 12.89629 12.89770 12.89911 12.90051
## [113] 12.90190 12.90327 12.90462 12.90595 12.90725 12.90852 12.90976 12.91096
## [121] 12.91239 12.91432 12.91670 12.91949 12.92266 12.92617 12.92998 12.93406
## [129] 12.93836 12.94286 12.94750 12.95226 12.95709 12.96197 12.96684 12.97168
## [137] 12.97644 12.98109 12.98559 12.98991 12.99400 12.99783 13.00135 13.00454
## [145] 13.00736 13.00976 13.01171 13.01443 13.01902 13.02528 13.03301 13.04202
## [153] 13.05211 13.06306 13.07469 13.08679 13.09917 13.11161 13.12393 13.13593
## [161] 13.14739 13.15813 13.16795 13.17663 13.18399 13.18982 13.19392 13.19610
## [169] 13.19746 13.19922 13.20134 13.20377 13.20647 13.20939 13.21248 13.21570
## [177] 13.21901 13.22236 13.22570 13.22899 13.23219 13.23524 13.23811 13.24075
## [185] 13.24311 13.24515 13.24682 13.24808 13.24889 13.24919 13.24894 13.24810
## [193] 13.24663 13.24447 13.24158 13.23792 13.23343 13.22809 13.22153 13.21350
## [201] 13.20414 13.19357 13.18191 13.16929 13.15584 13.14168 13.12694 13.11175
## [209] 13.09622 13.08049 13.06468 13.04892 13.03333 13.01804 13.00317 12.98885
## [217] 12.97520 12.96236 12.95044 12.93779 12.92279 12.90569 12.88670 12.86606
## [225] 12.84399 12.82072 12.79648 12.77149 12.74598 12.72018 12.69432 12.66862
## [233] 12.64331 12.61862 12.59477 12.57200 12.55053 12.53058 12.51239 12.49618
## [241] 12.48049 12.46376 12.44611 12.42765 12.40850 12.38875 12.36853 12.34795
## [249] 12.32711 12.30613 12.28511 12.26418 12.24345 12.22301 12.20299 12.18350
## [257] 12.16464 12.14654 12.12929 12.11302 12.09783 12.08362 12.07018 12.05743
## [265] 12.04532 12.03379 12.02276 12.01218 12.00198 11.99209 11.98246 11.97302
## [273] 11.96370 11.95445 11.94519 11.93587 11.92641 11.91677 11.90686 11.89663
## [281] 11.88602 11.87496 11.86410 11.85409 11.84486 11.83632 11.82843 11.82109
## [289] 11.81424 11.80781 11.80172 11.79592 11.79031 11.78484 11.77942 11.77400
## [297] 11.76849 11.76283 11.75694 11.75076 11.74420 11.73721 11.72970 11.72118
## [305] 11.71129 11.70022 11.68813 11.67521 11.66164 11.64758 11.63321 11.61872
## [313] 11.60427 11.59004 11.57621 11.56296 11.55046 11.53888 11.52840 11.51921
## [321] 11.51147 11.50536 11.50105 11.49873 11.49737 11.49589 11.49432 11.49272
## [329] 11.49115 11.48966 11.48831 11.48713 11.48620 11.48556 11.48526 11.48536
## [337] 11.48592 11.48697 11.48859 11.49081 11.49370 11.49730 11.50167 11.50687
## [345] 11.51294 11.51953 11.52628 11.53320 11.54033 11.54769 11.55531 11.56320
## [353] 11.57141 11.57994 11.58884 11.59812 11.60781 11.61794 11.62854 11.63962
## [361] 11.65121 11.66335 11.67605 11.68934 11.70326 11.71781 11.73293 11.74849
## [369] 11.76452 11.78099 11.79792 11.81531 11.83314 11.85144 11.87018 11.88938
## [377] 11.90904 11.92915 11.94971 11.97073 11.99220 12.01412 12.03651 12.05934
## [385] 12.08263 12.10638 12.13058 12.15523 12.18034 12.20590 12.23192 12.25839
## [393] 12.28532 12.31270 12.34054 12.36883 12.39758 12.42679 12.45644 12.48656
## [401] 12.51713 12.54815 12.57963 12.61156 12.64395 12.67680 12.71010 12.74385#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 408)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.55298 12.55116 12.54937 12.54761 12.54590 12.54423 12.54261 12.54103
## [9] 12.53949 12.53800 12.53656 12.53517 12.53383 12.53255 12.53132 12.53014
## [17] 12.52902 12.52796 12.52696 12.52602 12.52515 12.52434 12.52359 12.52291
## [25] 12.52230 12.52176 12.52129 12.52089 12.52057 12.52032 12.52015 12.52006
## [33] 12.52005 12.52012 12.52027 12.52050 12.52082 12.52121 12.52167 12.52221
## [41] 12.52281 12.52349 12.52424 12.52506 12.52595 12.52690 12.52792 12.52901
## [49] 12.53016 12.53137 12.53264 12.53398 12.53537 12.53683 12.53834 12.53991
## [57] 12.54154 12.54322 12.54495 12.54674 12.54858 12.55048 12.55242 12.55441
## [65] 12.55645 12.55854 12.56068 12.56286 12.56508 12.56735 12.56966 12.57201
## [73] 12.57441 12.57684 12.57931 12.58182 12.58437 12.58695 12.58966 12.59258
## [81] 12.59572 12.59905 12.60258 12.60628 12.61016 12.61421 12.61840 12.62275
## [89] 12.62723 12.63184 12.63657 12.64141 12.64635 12.65138 12.65650 12.66170
## [97] 12.66696 12.67227 12.67764 12.68305 12.68848 12.69394 12.69942 12.70489
## [105] 12.71037 12.71583 12.72127 12.72667 12.73204 12.73736 12.74262 12.74781
## [113] 12.75293 12.75797 12.76291 12.76775 12.77248 12.77709 12.78157 12.78592
## [121] 12.79060 12.79605 12.80218 12.80892 12.81618 12.82389 12.83198 12.84035
## [129] 12.84894 12.85766 12.86644 12.87519 12.88383 12.89230 12.90050 12.90836
## [137] 12.91581 12.92275 12.92912 12.93484 12.93982 12.94399 12.94837 12.95397
## [145] 12.96065 12.96826 12.97668 12.98577 12.99538 13.00539 13.01565 13.02604
## [153] 13.03640 13.04661 13.05653 13.06603 13.07495 13.08318 13.09057 13.09698
## [161] 13.10229 13.10634 13.10901 13.11123 13.11401 13.11730 13.12103 13.12517
## [169] 13.12966 13.13446 13.13951 13.14477 13.15017 13.15568 13.16124 13.16681
## [177] 13.17233 13.17775 13.18302 13.18810 13.19293 13.19746 13.20164 13.20543
## [185] 13.20877 13.21161 13.21390 13.21559 13.21664 13.21699 13.21659 13.21539
## [193] 13.21334 13.21039 13.20650 13.20160 13.19493 13.18587 13.17465 13.16149
## [201] 13.14661 13.13024 13.11259 13.09389 13.07435 13.05421 13.03369 13.01299
## [209] 12.99236 12.97200 12.95214 12.93300 12.91481 12.89778 12.88214 12.86810
## [217] 12.85590 12.84342 12.82859 12.81162 12.79278 12.77230 12.75042 12.72738
## [225] 12.70342 12.67878 12.65371 12.62845 12.60323 12.57829 12.55389 12.53025
## [233] 12.50763 12.48625 12.46637 12.44822 12.43204 12.41807 12.40519 12.39210
## [241] 12.37884 12.36544 12.35192 12.33833 12.32468 12.31100 12.29733 12.28369
## [249] 12.27012 12.25664 12.24329 12.23009 12.21707 12.20426 12.19169 12.17940
## [257] 12.16740 12.15574 12.14443 12.13396 12.12468 12.11650 12.10928 12.10294
## [265] 12.09733 12.09237 12.08792 12.08389 12.08014 12.07658 12.07309 12.06955
## [273] 12.06585 12.06188 12.05752 12.05267 12.04720 12.04100 12.03396 12.02597
## [281] 12.01811 12.01145 12.00588 12.00129 11.99754 11.99453 11.99214 11.99025
## [289] 11.98874 11.98749 11.98640 11.98533 11.98417 11.98281 11.98112 11.97899
## [297] 11.97630 11.97294 11.96878 11.96371 11.95761 11.95004 11.94079 11.93005
## [305] 11.91801 11.90489 11.89087 11.87615 11.86094 11.84544 11.82983 11.81433
## [313] 11.79912 11.78441 11.77040 11.75728 11.74525 11.73452 11.72528 11.71773
## [321] 11.71207 11.70850 11.70575 11.70247 11.69876 11.69471 11.69041 11.68593
## [329] 11.68138 11.67684 11.67240 11.66815 11.66417 11.66056 11.65739 11.65478
## [337] 11.65279 11.65152 11.65105 11.65149 11.65290 11.65539 11.65905 11.66329
## [345] 11.66754 11.67183 11.67618 11.68066 11.68528 11.69009 11.69513 11.70043
## [353] 11.70603 11.71197 11.71829 11.72503 11.73222 11.73991 11.74812 11.75690
## [361] 11.76628 11.77631 11.78702 11.79845 11.81040 11.82263 11.83516 11.84800
## [369] 11.86117 11.87467 11.88851 11.90272 11.91729 11.93223 11.94757 11.96331
## [377] 11.97947 11.99605 12.01306 12.03052 12.04844 12.06682 12.08569 12.10505
## [385] 12.12491 12.14529 12.16619 12.18770 12.20989 12.23274 12.25622 12.28032
## [393] 12.30501 12.33028 12.35609 12.38244 12.40930 12.43664 12.46446 12.49272
## [401] 12.52141 12.55050 12.57998 12.60983 12.64001 12.67052 12.70133 12.73242#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 408)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 12.00123 11.99623 11.99131 11.98647 11.98169 11.97699 11.97236 11.96781
## [9] 11.96333 11.95893 11.95461 11.95036 11.94619 11.94209 11.93808 11.93414
## [17] 11.93028 11.92651 11.92281 11.91919 11.91566 11.91221 11.90884 11.90556
## [25] 11.90235 11.89924 11.89621 11.89326 11.89040 11.88762 11.88494 11.88234
## [33] 11.87983 11.87741 11.87507 11.87283 11.87068 11.86862 11.86665 11.86477
## [41] 11.86298 11.86129 11.85969 11.85821 11.85686 11.85565 11.85456 11.85360
## [49] 11.85277 11.85206 11.85146 11.85098 11.85062 11.85037 11.85022 11.85018
## [57] 11.85025 11.85041 11.85067 11.85103 11.85148 11.85201 11.85264 11.85335
## [65] 11.85414 11.85501 11.85595 11.85697 11.85806 11.85921 11.86044 11.86172
## [73] 11.86307 11.86447 11.86593 11.86743 11.86899 11.87060 11.87225 11.87393
## [81] 11.87566 11.87743 11.87922 11.88105 11.88291 11.88483 11.88685 11.88898
## [89] 11.89120 11.89353 11.89595 11.89846 11.90107 11.90377 11.90656 11.90943
## [97] 11.91240 11.91544 11.91858 11.92179 11.92508 11.92845 11.93190 11.93542
## [105] 11.93902 11.94268 11.94642 11.95022 11.95410 11.95803 11.96203 11.96609
## [113] 11.97021 11.97439 11.97862 11.98291 11.98726 11.99165 11.99610 12.00059
## [121] 12.00513 12.00971 12.01434 12.01900 12.02371 12.02846 12.03396 12.04084
## [129] 12.04897 12.05821 12.06843 12.07948 12.09125 12.10358 12.11635 12.12941
## [137] 12.14264 12.15591 12.16906 12.18198 12.19451 12.20654 12.21792 12.22851
## [145] 12.23819 12.24682 12.25426 12.26265 12.27400 12.28801 12.30436 12.32274
## [153] 12.34283 12.36434 12.38694 12.41033 12.43418 12.45820 12.48207 12.50547
## [161] 12.52809 12.54963 12.56977 12.58820 12.60460 12.61867 12.63009 12.63856
## [169] 12.64570 12.65334 12.66140 12.66983 12.67856 12.68755 12.69672 12.70602
## [177] 12.71540 12.72478 12.73411 12.74333 12.75238 12.76121 12.76974 12.77793
## [185] 12.78570 12.79301 12.79980 12.80599 12.81153 12.81637 12.82045 12.82369
## [193] 12.82605 12.82747 12.82788 12.82722 12.82544 12.82247 12.81740 12.80952
## [201] 12.79909 12.78637 12.77160 12.75506 12.73699 12.71765 12.69730 12.67620
## [209] 12.65461 12.63277 12.61095 12.58940 12.56839 12.54816 12.52898 12.51110
## [217] 12.49478 12.48027 12.46784 12.45529 12.44044 12.42349 12.40469 12.38425
## [225] 12.36242 12.33941 12.31546 12.29079 12.26563 12.24021 12.21476 12.18951
## [233] 12.16468 12.14050 12.11720 12.09502 12.07417 12.05488 12.03740 12.02193
## [241] 12.00725 11.99202 11.97629 11.96012 11.94358 11.92673 11.90962 11.89232
## [249] 11.87489 11.85738 11.83986 11.82239 11.80503 11.78783 11.77087 11.75419
## [257] 11.73787 11.72195 11.70651 11.69160 11.67728 11.66337 11.64964 11.63609
## [265] 11.62271 11.60952 11.59651 11.58367 11.57100 11.55851 11.54619 11.53404
## [273] 11.52206 11.51025 11.49860 11.48713 11.47582 11.46467 11.45368 11.44286
## [281] 11.43220 11.42169 11.41171 11.40258 11.39422 11.38658 11.37959 11.37318
## [289] 11.36729 11.36185 11.35680 11.35207 11.34760 11.34332 11.33916 11.33506
## [297] 11.33096 11.32678 11.32246 11.31795 11.31316 11.30804 11.30252 11.29628
## [305] 11.28912 11.28118 11.27257 11.26343 11.25388 11.24405 11.23407 11.22406
## [313] 11.21416 11.20448 11.19517 11.18633 11.17812 11.17064 11.16402 11.15840
## [321] 11.15391 11.15066 11.14879 11.14842 11.14873 11.14884 11.14881 11.14869
## [329] 11.14855 11.14843 11.14841 11.14853 11.14886 11.14944 11.15035 11.15162
## [337] 11.15334 11.15554 11.15829 11.16164 11.16566 11.17040 11.17591 11.18226
## [345] 11.18950 11.19726 11.20511 11.21310 11.22125 11.22959 11.23816 11.24698
## [353] 11.25607 11.26548 11.27523 11.28534 11.29586 11.30680 11.31819 11.33008
## [361] 11.34248 11.35543 11.36895 11.38307 11.39783 11.41325 11.42923 11.44565
## [369] 11.46251 11.47981 11.49755 11.51572 11.53434 11.55339 11.57288 11.59281
## [377] 11.61317 11.63397 11.65521 11.67688 11.69899 11.72154 11.74452 11.76794
## [385] 11.79179 11.81608 11.84080 11.86596 11.89155 11.91758 11.94404 11.97093
## [393] 11.99826 12.02602 12.05421 12.08284 12.11189 12.14138 12.17130 12.20166
## [401] 12.23244 12.26366 12.29530 12.32738 12.35989 12.39283 12.42619 12.45999#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")